home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 2).iso / 1276 / test30.frm < prev    next >
Text File  |  1996-02-20  |  4KB  |  166 lines
  1. VERSION 2.00
  2. Begin Form TestForm 
  3.    Caption         =   "This is a test project for Project Analyzer"
  4.    ClientHeight    =   1080
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   5160
  8.    Height          =   1485
  9.    Icon            =   TEST30.FRX:0000
  10.    Left            =   1035
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   1080
  13.    ScaleWidth      =   5160
  14.    Top             =   1140
  15.    Width           =   5280
  16.    Begin DriveListBox Drive1 
  17.       Height          =   315
  18.       Left            =   210
  19.       TabIndex        =   2
  20.       Top             =   630
  21.       Width           =   2535
  22.    End
  23.    Begin CommandButton Quit 
  24.       Caption         =   "Quit"
  25.       Height          =   330
  26.       Left            =   3780
  27.       TabIndex        =   0
  28.       Top             =   630
  29.       Width           =   1275
  30.    End
  31.    Begin Image Image1 
  32.       Height          =   480
  33.       Left            =   4515
  34.       Picture         =   TEST30.FRX:0302
  35.       Top             =   45
  36.       Width           =   480
  37.    End
  38.    Begin Label Label1 
  39.       Caption         =   "This program will not do anything"
  40.       Height          =   330
  41.       Left            =   210
  42.       TabIndex        =   1
  43.       Top             =   90
  44.       Width           =   4320
  45.    End
  46. End
  47. ' ProjTest.Frm - a test project for Project Analyzer
  48. ' (C)1995 MyCompany Ltd.
  49. ' This is the form of the main screen
  50. ' This file also includes some important database routines
  51.  
  52. DefStr W
  53.  
  54. Dim DatabaseName As String
  55. Dim DatabaseOpen As Integer
  56. Dim Weekdays(0 To 6)
  57.  
  58. Const MAX_BUTTONS = 50
  59. Dim Button(0 To MAX_BUTTONS) As CommandButton
  60.  
  61. Dim FName As String
  62. ' This is a module-level variable that overrides the
  63. ' global variable FName in FILETEST.BAS
  64.  
  65. Sub CloseDatabase ()
  66. ' Close the database
  67. ' Check that all information is up-to-date
  68.  
  69. End Sub
  70.  
  71. Function ExtensionOnly (ByVal File As String) As String
  72. ' Returns file name extension "BAS"
  73. ' This is a module-level function that will override
  74. ' the global function ExtensionOnly defined in FILETEST.BAS
  75.  
  76. ExtensionOnly = Right(File, 3)
  77.  
  78. End Function
  79.  
  80. Function Fibonacci (ByVal n As Integer)
  81. ' Sample of a recursive call sequence
  82. ' This function is only called by SumFibonacci
  83. ' but not by any other procedure
  84. ' -> Fibonacci and SumFibonacci are dead code
  85.  
  86. If n = 1 Then
  87.     Fibonacci = 1
  88. ElseIf n = 2 Then
  89.     Fibonacci = 1
  90. Else
  91.     Fibonacci = SumFibonacci(n - 1, n - 2)
  92. End If
  93.  
  94. End Function
  95.  
  96. Sub Form_Load ()
  97. ' Start of the program
  98.  
  99. Set Button(0) = Quit
  100. ReadINIFile
  101. OpenDB
  102. RunTheProgram
  103.  
  104. End Sub
  105.  
  106. Sub Form_Unload (Cancel As Integer)
  107. ' Quit the program
  108. ' First close the database
  109.  
  110. CloseDatabase
  111. End
  112.  
  113. End Sub
  114.  
  115. Sub OpenDB ()
  116. ' Opening the DB
  117. ' Check for user rights
  118. ' Lock appropriate tables
  119.  
  120. If ExtensionOnly(FName) = "TXT" Then
  121.     ' It is a text database
  122. ElseIf IsDir("C:\WINDOWS") Then
  123.     If DriveType("C:", Drive1) <> DRIVE_FIXED Then
  124.         ' Panic
  125.     Else
  126.         ' Don't panic
  127.     End If
  128. End If
  129.  
  130. End Sub
  131.  
  132. Sub Quit_Click ()
  133.  
  134. Unload Me
  135.  
  136. End Sub
  137.  
  138. Sub ReadINIFile ()
  139. ' Read the configuration in PROJTEST.INI
  140. ' Note: If PROJTEST.INI doesn't exist, use defaults
  141.  
  142. IsThere = IsFile("PROJTEST.INI")
  143.  
  144. End Sub
  145.  
  146. Sub RunTheProgram ()
  147. ' Run the program only if there is at least 1 MB free
  148. ' disk space
  149. ' Otherwise show error message
  150.  
  151. If DiskSpaceFree("C:") < 1024 ^ 2 Then
  152. End If
  153.  
  154. End Sub
  155.  
  156. Function SumFibonacci (a, b)
  157. ' Sample of a recursive call sequence
  158. ' This function is only called by Fibonacci
  159. ' but not by any other procedure
  160. ' -> Fibonacci and SumFibonacci are dead code
  161.  
  162. SumFibonacci = Fibonacci(a) + Fibonacci(b)
  163.  
  164. End Function
  165.  
  166.